home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / encorsrc.lha / encore_sources / sys / maxkernel.t < prev    next >
Text File  |  1988-05-02  |  15KB  |  372 lines
  1. (herald maxkernel
  2.   (env tsys))
  3.  
  4. ;;; Copyright (c) 1985 Yale University
  5. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  6. ;;; This material was developed by the T Project at the Yale University Computer 
  7. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  8. ;;; and to use it for any purpose is granted, subject to the following restric-
  9. ;;; tions and understandings.
  10. ;;; 1. Any copy made of this software must include this copyright notice in full.
  11. ;;; 2. Users of this software agree to make their best efforts (a) to return
  12. ;;;    to the T Project at Yale any improvements or extensions that they make,
  13. ;;;    so that these may be included in future readdrses; and (b) to inform
  14. ;;;    the T Project of noteworthy uses of this software.
  15. ;;; 3. All materials developed as a consequence of the use of this software
  16. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  17. ;;;    of acknowledging credit in academic research.
  18. ;;; 4. Yale has made no warrantee or representation that the operation of
  19. ;;;    this software will be error-free, and Yale is under no obligation to
  20. ;;;    provide any services, by way of maintenance, update, or otherwise.
  21. ;;; 5. In conjunction with products arising from the use of this material,
  22. ;;;    there shall be no use of the name of the Yale University nor of any
  23. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  24. ;;;    without prior written consent from Yale in each case.
  25. ;;;
  26.  
  27. ;;; The procedure big_bang MUST come first in this file.     boot-arg-offset
  28. ;;;  When we enter Big_bang the stack looks as follows:
  29. ;;;              ________________
  30. ;;;              |   debug?      |   not a boot arg
  31. ;;;              |_______________|
  32. ;;;              |      argv     |    Command line argv
  33. ;;;              |_______________|
  34. ;;;              |      argc     |    Command line argc
  35. ;;;              |_______________|
  36. ;;;              |  heap-size    |    Size of the static storage area
  37. ;;;              |_______________|
  38. ;;;              |     heap2     | Base addresss of static
  39. ;;;              |_______________|        storage area
  40. ;;;              |     heap1     |
  41. ;;;              |_______________|
  42. ;;;       SP =>  |  return addr  |
  43. ;;;              |_______________|
  44. ;;;
  45. ;;; The address of interrupt_xenoid (see $BUILD/max_start_t.s) is in S0.
  46.  
  47. ;++ replace the numbers 1 and 3 below with boot/heap1 and boot/heap-size
  48.  
  49. (define (big_bang) 
  50.   (lap (n32-big-bang *boot*)
  51.  
  52.     ;; set up global-constants
  53.     (ashi d ($ 2) S0)   
  54.     (movi d S0 (d@r nil-reg slink/interrupt-handler))
  55.     (spri d SP A1)                                            ; save ptr to args
  56.     (movi d ($ (fx+ (fixnum-ashl 6 8) header/general-vector)) ; 6 boot-args
  57.           (tos))
  58.     (addr (d@r SP 2) A2)                                    ; second arg to boot
  59.     (movi d A2 (d@r nil-reg slink/boot-args))                 ; set up boot-args
  60.  
  61.     (movi d (d@r P (static 'n32-big-bang)) P)
  62.     (movi d (d@r p 2) p)
  63.     (movi d (d@r P -2) A2)
  64.     (addr (label big-bang-return) AN)          ; temp because TP is special
  65.     (movi d AN TP)
  66. ;;; note that pointer to boot args is in A1
  67.     (jump (@r A2))                  
  68. big-bang-return
  69.     ;; initialize area,area-frontier and area-limit
  70.     (movi d (d@r A1 4) S0)         ; get address of heap
  71.     (movi d S0 (d@r TASK task/area-begin))          
  72.     (movi d S0 (d@r TASK task/area-frontier))       
  73.     (addi d (d@r A1 12) S0)         ; add size to base
  74.     (movi d S0 (d@r TASK task/area-limit))          
  75.  
  76.     ;; Set up the procedure register P and call boot,
  77.     ;; never to return. (note: arg 2 (*boot-args*) setup above)
  78.     (spri d nil-reg A3)
  79.     (cmpi b ($ 0) (d@r A1 24))
  80.     (j= %debug)
  81.     (movi d ($ header/true) A3)
  82. %debug
  83.     (addr (d@r TASK %%task-header-offset) A1)       ; root-process
  84.     (movi d ($ 4) NARGS)                              ; 3 args
  85.     (movi d (d@r P (static '*boot*)) P)
  86.     (movi d (d@r p 2) p)
  87.     (movi d (d@r P -2) TP)
  88.     (jump  (@r TP))))
  89.  
  90. (define (call-fault-handler)
  91.   (lap (signal-handler)
  92.  
  93.     (equate t-interrupt      (fixnum-ashl  2 2))   ; UNIX signal codes
  94.     (equate t-virtual-timer  (fixnum-ashl 26 2))
  95.  
  96.     (movi d ($ t-interrupt) A1)                      ; signal code is arg 1
  97.     (tbiti b ($ 1) (d@r TASK (fx+ task/critical-count 3)))  ; t-interrupt?
  98.     (jfs %call-fault)                               ; test F flag
  99.     (movi d ($ t-virtual-timer) A1)
  100. %call-fault                                
  101.     (addr (d@r SP (fx+ 4 tag/extend)) A2)          ; fault frame is arg 2
  102.     (movi d (d@r P (static 'signal-handler)) P)
  103.     (movi d (d@r p 2) p)
  104.     (movi d (d@r P -2) TP)
  105.     (movi b ($ 0) (d@r TASK (fx+ task/critical-count 3)))
  106.     (jump (@r TP))))                                
  107.  
  108.  
  109. ;;;; Various return points pushed as continuations by INTERRUPT_DISPATCHER
  110.  
  111. ;;; Return from fault handler when originally interrupted in T code
  112. (lap-template (0 0 -1 t stack %fault-frame-handler)
  113. %fault-frame-template
  114.     (equate %%fault-sp-offset 20)               
  115.     (equate %%df_r2 16)
  116.     (equate %%df_r3 -44)
  117.     (equate %%df_r4 -40)
  118.     (equate %%df_r5 -36)
  119.     (equate %%df_r6 -32)
  120.     (equate %%df_fp -28)
  121.     (equate %%df_pc       24)
  122.  
  123.     (ori b ($ #b01000000) (d@r TASK (fx+ task/critical-count 3)))  ; ignore int's
  124.     (movi d (d@r SP 4) S0)                    ; fault header
  125.     (ashi d ($ -8) S0)
  126.     (addi d ($ 2) S0)                         ; 2 for header and template
  127.     (cmpi d ($ 0) (d@r SP 12))
  128.     (j= foobar)
  129.     (movi d (d@r SP 12) (index-d (@r SP) S0)) ; restore hacked top of stack
  130. foobar
  131.     (adjspi b ($ -16))         ; pop template, header, pointers on stack, hack top
  132.         ;; 10 = 3 (extra p & s & task/scratch) + 6 (pointer regs) + 1 (pc)
  133.     (movi d (d@r SP (* (+ *pointer-temps* *scratch-temps* 10) 4))
  134.           A1)                      ; context.  pushed in %fault-save-loop above
  135.     (movi d (tos) (d@r A1 %%df_pc))
  136.     (movi d (tos) (d@r A1 %%df_r2))    ; P
  137.     (movi d (tos) (d@r A1 %%df_r3))    ; A1
  138.     (movi d (tos) (d@r A1 %%df_r4))    ; A2
  139.     (movi d (tos) (d@r A1 %%df_r5))    ; A3
  140.     (movi d (tos) (d@r A1 %%df_r6))    ; AN
  141.     (movi d (tos) (d@r A1 %%df_fp))    ; TP
  142.  
  143.     (movi d ($ -3) S0)                              ; extra p & s & task/scratch
  144. %fault-restore-loop                                 ; restore temps
  145.     (movi d (tos) (index-d (@r TASK) S0))
  146.     (addi d ($ 1) S0)
  147.     (cmpi d ($ (fx/ temp-block-size 4)) S0)
  148.     (j> %fault-restore-loop)
  149.     (adjspi b ($ -4))                                  ; pop context
  150.     (bici b ($ #b01000000) (d@r TASK (fx+ task/critical-count 3)))
  151.     (ret ($ 0))
  152. %fault-frame-handler
  153.     (spri d nil-reg AN)
  154.     (ret ($ 0)))
  155.  
  156. ;;; Return from fault handler when originally interrupted in foreign code
  157. (lap-template (0 0 -1 nil stack handle-foreign-return)
  158. %foreign-return
  159.     (ori b ($ #b01000000) (d@r TASK (fx+ task/critical-count 3)))  ; ignore int's
  160.     (adjspi b ($ -8))                         ; pop template,header
  161.     (movi d (tos) (d@r TASK task/foreign-call-cont))
  162.     (bici b ($ #b01000000) (d@r TASK (fx+ task/critical-count 3)))
  163.     (ret ($ 0))
  164. handle-foreign-return
  165.     (spri d nil-reg AN)
  166.     (ret ($ 0)))
  167.  
  168. (lap-template (0 0 -1 nil stack handle-enable-return)
  169. %re-enabled
  170.     (adjspi b ($ -4))                         ; pop return address
  171.     (ret ($ 0))
  172. handle-enable-return
  173.     (spri d nil-reg AN)
  174.     (ret ($ 0)))
  175.  
  176. (lap-template (0 0 -1 nil stack handle-doing-gc-return)
  177. %doing-gc-return
  178.     (adjspi b ($ -4))                         ; pop return address
  179.     (ret ($ 0))
  180. handle-doing-gc-return
  181.     (spri d nil-reg AN)
  182.     (ret ($ 0)))
  183.  
  184.  
  185.  
  186. ;;; This is T's fault handler, called by UNIX fault handler via 
  187. ;;; assembly routine INTERRUPT_XENOID.
  188. ;;;     S0 contains UNIX signal code 
  189. ;;;     A1 contains context
  190.  
  191. ;;; Interrupts can be deferred.   
  192. ;;; the task/critical count byte has
  193. ;;; bit 7 -- interrupts deferred
  194. ;;; bit 6 -- interrupts ignored
  195. ;;; bit 1 -- quit pending
  196. ;;; bit 0 -- timer interrupt pending
  197.  
  198. (define (interrupt_dispatcher)
  199.   (lap (signal-handler enable-signals gc_interrupt)
  200.  
  201.     (equate %%fault-sp-offset 20)               
  202.     (equate %%df_r2 16)
  203.     (equate %%df_r3 -44)
  204.     (equate %%df_r4 -40)
  205.     (equate %%df_r5 -36)
  206.     (equate %%df_r6 -32)
  207.     (equate %%df_fp -28)
  208.     (equate %%df_pc       24)
  209.     (equate fault-interrupt      2)                       ; UNIX signal codes
  210.     (equate fault-quit           3)
  211.     (equate fault-virtual-timer 26)
  212.                                              
  213.     (movi d S0 A2)               ; save signal code
  214. ;    (movi d (d@r P (static '*the-slink*)) nil-reg)
  215.     (lpri d TASK (d@r nil-reg slink/current-task))          ; restore task
  216.     (tbiti b ($ 6) (d@r TASK (fx+ task/critical-count 3)))  ; ignoring int's? 
  217.     (jfs %ignore-interrupt)                                 ; test F flag
  218.     (cmpi d ($ fault-virtual-timer) S0)                     ; timer interrupt?
  219.     (j= %timer)                                   
  220.     (cmpi d ($ fault-interrupt) S0)                         ; is this a ^q?
  221.     (jn= %fault)                                            ; if so ...
  222.     (cmpi d (d@r TASK task/doing-gc?) (d@r nil-reg slink/nil-car)) ; are we doing gc?
  223.     (jn= %doing-gc)                                         ; if not ...
  224.     (cmpi b ($ 0) (d@r TASK task/foreign-call-cont))
  225.     (jn= %fault)                                             ; if so ...
  226.     (tbiti b ($ 1) (d@r TASK (fx+ task/critical-count 3)))
  227.     (jfc %set-interrupt-flag)
  228.     (andi b ($ #b11111101) (d@r TASK (fx+ task/critical-count 3)))
  229.     (cmpi b ($ 0) (d@r TASK (fx+ task/critical-count 3)))
  230.     (j= %fault)
  231. %set-interrupt-flag
  232.     (ori b ($ #b10) (d@r TASK (fx+ task/critical-count 3))) ; set "quit pending"
  233.     (jbr %ignore-interrupt)
  234. %timer
  235.     (cmpi d (d@r TASK task/doing-gc?) (d@r nil-reg slink/nil-car)) ; are we doing gc?
  236.     (jn= %ignore-interrupt)                                 ; if so, ignore int
  237.     (cmpi b ($ 0) (d@r TASK (fx+ task/critical-count 3)))   ; are int's deferred?
  238.     (j= %fault)                                             ; if so ...
  239.     (ori b ($ 1) (d@r TASK (fx+ task/critical-count 3)))    ; set timer bit 
  240. %ignore-interrupt
  241.     (addr (label %re-enabled) (tos))                        ; re-enable interrupts
  242.     (movi d (d@r P (static 'enable-signals)) P)             ; DON'T CONS!!!
  243.     (movi d (d@r p 2) p)
  244.     (movi d (d@r P -2) TP)
  245.     (jump (@r TP))
  246.  
  247. %doing-gc
  248.     (addr (label %doing-gc-return) (tos))
  249.     (movi d (d@r P (static 'gc_interrupt)) P)
  250.     (movi d (d@r p 2) p)
  251.     (movi d (d@r P -2) TP)
  252.     (jump (@r TP))
  253.  
  254.  
  255. ;;; Interrupts are disabled here.  (i.e. Signals are disabled at OS level)
  256. %fault
  257.     (movi d (d@r TASK task/foreign-call-cont) S0)
  258.     (cmpi d ($ 0) S0)
  259.     (j=  %t-code-interrupt)
  260.  
  261.     ;; Interrupted out of foreign code.
  262.     (movi d ($ 0) (d@r TASK task/foreign-call-cont))     
  263.     (movi d S0 (tos))                              ; push foreign continuation
  264.     (spri d SP AN)                                 ; can't subtract directly...
  265.     (subi d AN S0)                                 ; compute frame size
  266.     (ashi d ($ 6) S0)                              ; shift to byte 2
  267.     (movi b ($ (fx+ header/fault-frame 128)) S0)   ; add header, foreign bit
  268.     (movi d S0 (tos))                              ; push fault frame header
  269.     (addr (label %foreign-return) (tos))           ; push continuation
  270.     (jbr %fault-done)
  271.                                  
  272. ;;; registers:  use AN for fault-sp.  Still have A1 = context
  273. %t-code-interrupt                    
  274.     (movi d A1 (tos))                                   ; save context
  275.     (movi d (d@r A1 %%fault-sp-offset) AN)            ; get fault SP in AN
  276.  
  277.     (movi d ($ (fx/ (fx+ temp-block-size 8) 4)) S0)
  278. %fault-save-loop                                    ; save temps and extra p & s
  279.     (movi d (index-d (d@r TASK -12) S0) (tos))      ; and task/scratch
  280.     (subi d ($ 1) S0)
  281.     (cmpi d S0 ($ 0))
  282.     (j>= %fault-save-loop)
  283.  
  284.     (movi d (d@r A1 %%df_fp) (tos))         ; TP (FP)
  285.     (movi d (d@r A1 %%df_r6) (tos))         ; AN (R6)
  286.     (movi d (d@r A1 %%df_r5) (tos))         ; A3 (R5)
  287.     (movi d (d@r A1 %%df_r4) (tos))         ; A2 (R4)
  288.     (movi d (d@r A1 %%df_r3) (tos))         ; A1 (R3)
  289.     (movi d (d@r A1 %%df_r2) (tos))         ; P  (R2)
  290.     (movi d (d@r A1 %%df_pc) S0)
  291.     (movi d S0 (tos))
  292.     (cmpi d (d@r nil-reg slink/kernel-begin) S0)
  293.     (j> %not-in-kernel)
  294.     (cmpi d (d@r nil-reg slink/kernel-end) S0)
  295.     (j< %not-in-kernel)
  296.     (movi d (@r AN) (tos))                  ; save hack top of stack
  297.     (movi d ($ 0) (tos))                    ; # of pointers on stack was 0
  298.     (jbr %t-code-done)
  299.  
  300. %not-in-kernel
  301.     (movi d ($ 0) (tos))                    ; no hacked stack top
  302.  
  303. ;;; find how many pointers were top of stack at time of fault
  304. ;;; AN - sp at fault time
  305. ;;; S0 -  search pointer
  306. ;;; A3 - next pointer slot from stack
  307. ;;; NARGS - temp
  308.  
  309.     (movi d AN S0)                             ; start search at fault sp
  310. %find-last-template-loop
  311.     (movi d (@r S0) A3)                        ; load next word
  312.     (addi d ($ 4) S0)
  313.     (cmpi b ($ header/vframe) A3)              ; vframe?
  314.     (j= %found-frame)                        ; .. if so, done looking
  315.  
  316.     (movi d A3 NARGS)                          ; copy for extend test
  317.     (andi b ($ #b11) NARGS)
  318.     (cmpi b ($ tag/extend) NARGS)              ; extend?
  319.     (jn= %find-last-template-loop)           ; .. if not, keep looking
  320.     (movi d (d@r A3 -2) nargs)
  321.     (andi b ($ #x7f) nargs)
  322.     (cmpi b ($ header/template) nargs)   ; template?
  323.     (jn= %find-last-template-loop)           ; .. if not, keep looking
  324.  
  325. %found-frame
  326.     (subi d AN S0)                             ; compute # of pointers (fixnum)
  327.     (subi d ($ 4) S0)                          ; (it was one too high)
  328.     (movi d S0 (tos))                            ; and push on stack
  329. %t-code-done
  330.     (spri d SP S0)
  331.     (subi d S0 AN)                             ; compute total size of frame (-)
  332.     (ashi d ($ 6) S0)                          ; move to byte 2
  333.     (movi b ($ header/fault-frame) S0)         ; add header
  334.     (movi d S0 (tos))                            ; push fault header
  335.     (addr (label %fault-frame-template) (tos)) ; continuation 
  336.  
  337. %fault-done                                            
  338.     (movi d A2 S0)  ; restore UNIX signal code
  339.     (ashi d ($ 2) S0)                          ; fixnumize
  340.     (movi d S0 A1)                             ; 1st argument is signal code
  341.     (addr (d@r SP 6) A2)                     ; 2nd argument is frame
  342.     (movi d (d@r P (static 'signal-handler)) p)
  343.     (movi d (d@r p 2) p)
  344.     (movi d (d@r P -2) TP)
  345.     (jump (@r TP))
  346.  
  347.     ))             
  348.                     
  349.  
  350. (define (local-machine)
  351.   (object nil                               
  352.       ((machine-type self)          'max)
  353.       ((machine-suspend-file self)  '(link maxsuspend))
  354.       ((page-size self)             2048)         ;?????
  355.       ((object-file-type self)      'no)
  356.       ((information-file-type self) 'ni)
  357.       ((noise-file-type self)       'nn)
  358.       ((print-type-string self)     "Machine")))
  359.  
  360. (define (nan? x) (ignore x) '#f)
  361.  
  362. (define (st_mtime stat-block)
  363.   (+ (ash (mref-16-u stat-block 34) 16) 
  364.      (mref-16-u stat-block 32)))
  365.  
  366. (define-integrable (st_size stat-block)
  367.   (mref-integer stat-block 20))
  368.  
  369.  
  370. (define-integrable (st_mode stat-block)
  371.   (mref-16-u stat-block 8))
  372.